Amiga Format CD 49/Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso/-websites-/wirenet/files/thor26_arexx.lha/Rexx/ShowHTML.thor

Text File | 1999-01-17 | 12KB | 468 lines

/*
** $VER: ShowHTML.thor 1.3 (27.3.98)
**
** by Eirik Nicolai Synnes <[e-mail]>
**
** ShowHTML.thor will send a HTML document in the message currently displayed
** in Thor's main window to a web browser.  First it searches for a browser
** already in memory and uses this one, uniconifying it if necessary.  If no
** browser is active it will launch the browser configured using CfgHTTP.thor.
**
** Currenly ShowHTML.thor recognizes IBrowse, AWeb, Voyager and AMosaic.
**
**
** New in 1.3:
**
**   o Supports attachments (inline images) in messages posted with
**     Netscape 4.0 and Microsoft Outlook Express (at least newer
**     versions)
**   o Improved screen-to-front and browser activation
**
**
** Fixed in 1.2:
**
**   o If ShowHTML wanted to display a requestor it would fail with
**     an ARexx error
**
**
** New in 1.1:
**
**   o HTML search routines vastly improved
**   o Added support for Voyager (2.88 tested, might not work with earlier
**     versions)
**   o Added support for AMosaic (not tested)
**   o Now uses CfgHTTP.thor's configuration file to figure out how to start
**     the browser
**   o Browser window is always brought to front and activated (if the
**     browser's ARexx port support it)
**   o Lots of minor enhancements and bug fixes
**
**
** Todo:
**
**   o Delete shows "Delete returned 20" if it couldn't delete the temporary
**     file. Is it possible to get rid of this?
**
**   o There's still some weird methods of attaching HTML documents
**     which ShowHTML doesn't check for
**
**   o See if it is possible to wait for something in order to avoid
**     temp file getting deleted before the browser has loaded it
**
*/

options results
options failat 31

signal on break_c
signal on halt
signal on error

globals = 'poster atts. htmlstem fileopen filename outfile THOR.LASTERROR BBSREAD.LASTERROR thorport msgtext. wwwcmd wwwport globals'

waitforport = 'SYS:RexxC/WaitForPort'

fileopen    = 0
filename    = 'T:SaveHTML.' || pragma('ID') || '.html'

poster      = ''
atts.count  = 0


/*
** See if I'm run from Thor
*/

if (left(address(), 5) = 'THOR.') then thorport = address()
else do
    say 'This script must be run from Thor.'
    exit(20)
    end


/*
** Find/open BBSREAD ARexx port
*/

if ~(show('P', 'BBSREAD')) then do
    address(command)
    'Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead'
    'WaitForPort BBSREAD'
    if (rc ~= 0) then displayerror(30, 'SortMail', 'Couldn''t open BBSREAD''s ARexx port.')
    end

call loadprefs()

/*
** Read the current message
*/

address(thorport)
'CURRENTMSG STEM 'curmsg
if (rc ~= 0) then call fail('Couldn''t detect a current message.')

address(bbsread)
'READBRMESSAGE "'curmsg.BBSNAME'" "'curmsg.CONFNAME'" 'curmsg.MSGNR' TEXTSTEM 'msgtext
if (rc ~= 0) then call fail('Couldn''t read message:\n'BBSREAD.LASTERROR)

/*
** Find out what program posted/mailed the message
*/

if (symbol('msgtext.COMMENT.COUNT') = 'VAR') & (msgtext.COMMENT.COUNT > 0) then do i = 1 to msgtext.COMMENT.COUNT while poster = ''
    if (upper(subword(msgtext.COMMENT.i, 2, 1)) = 'MOZILLA') then poster = 'mozilla'
    if (upper(subword(msgtext.COMMENT.i, 2, 3)) = 'MICROSOFT OUTLOOK EXPRESS') then poster = 'outlook'
end


/*
** Find out what browser(s) is/are active
*/

call findbrowser()

/*
** Find a text/html part
*/

if ~(findhtml('msgtext', 0)) then do
    if (symbol('msgtext.TEXT.COUNT') = 'VAR') & (msgtext.TEXT.COUNT > 0) then do
        address(thorport)
        'REQUESTNOTIFY TEXT "No text/html message part found.\nDo you want to send the first\nmessage part to the browser?" BT "Yes|No"'
        if (rc ~= 0) then do
            say 'Couldn''t open requester: 'THOR.LASTERROR
            exit(0)
        end
        if (result = 1) then call savemsg('msgtext')
        else exit(0)
    end
    else fail('No text/html message part found.')
end
else call savemsg(value('htmlstem'))


/*
** Display HTML document
*/

if symbol('wwwport') ~= 'VAR' then do
    address command 'Run <NIL: >NIL: 'wwwcmd' file://localhost/' || filename
    if (rc ~= 0) then fail('Failed to run browser.')
end
else do
    address(wwwport)
    select
        when wwwport = 'VOYAGER' then 'OPENURL file://localhost/' || filename
        when wwwport = 'IBROWSE' then 'GOTOURL file://localhost/' || filename
        when left(wwwport, 5) = 'AWEB.' then 'OPEN URL file://localhost/' || filename || ' RELOAD'
        when left(wwwport, 8) = 'AMOSAIC.' then 'JUMP URL file://localhost/' || filename
        otherwise nop
    end
    if (rc ~= 0) then call fail('Browser failed to display document.')
end


/*
** Activate browser window
*/

if (symbol('wwwport') ~= 'VAR') then call findbrowser

if (symbol('wwwport') = 'VAR') then do
    if (exists(waitforport)) then do
        do i = 1 to 6
            address(command)
            waitforport || ' ' || wwwport
            if (rc = 0) then leave i
        end
    end
    else say 'Hey, I could not find ' || waitforport || '. Please fix this!'

    if (rc ~= 0) then signal cleanup
end

address(wwwport)

select
    when (wwwport = 'VOYAGER') then do
        'SHOW'
        'ACTIVATE'
    end
    when (wwwport = 'IBROWSE') then do
        'SHOW'
        'SCREENTOFRONT'
        'ACTIVATE'
    end
    when (left(wwwport, 5) = 'AWEB.') then do
        'WINDOWTOFRONT'
        'SCREENTOFRONT'
        'ACTIVATEWINDOW'
    end
    when (left(wwwport, 8) = 'AMOSAIC.') then do
        'SHOW'
        'ACTIVATE'
    end
    otherwise nop
end

/*
** Clean up and exit
*/

cleanup:
break_c:
halt:
error:

if fileopen = 1 then call close(outfile)


/*
** See if the file can be deleted. Checks every 10 seconds.
*/

if exists(filename) then do
    options failat 31
    address(command)
    'Wait 10'
    do i = 1 to 12
        'Wait 10'
        'Delete >NIL: QUIET "'filename'"'
        if (rc = 0) then leave i
    end
end

exit(0)


/****************************************************************************
********************************** Procedures ********************************
 ***************************************************************************/


/**
*** Recursive function for finding text/html part and related message parts
**/

findhtml: interpret 'procedure expose 'globals
          parse arg tstem, saverel

foundct = 0; foundrel = 0; foundcid = 0

if (symbol(tstem'.COMMENT.COUNT') = 'VAR') & (value(tstem'.COMMENT.COUNT') > 0) then do i = 1 to value(tstem'.COMMENT.COUNT')
    curline = value(tstem'.COMMENT.i')

    if (index(upper(curline), 'CONTENT-TYPE:') > 0) then do
        content = substr(curline, index(upper(curline), 'CONTENT-TYPE:') + 13)
        if (index(content, ';') > 0) then content = substr(content, 1, index(content, ';'))
        content = compress(content, ' ;')

        if (upper(content) = 'TEXT/HTML') then foundct = 1
        if (upper(content) = 'MULTIPART/RELATED') then foundrel = 1
        drop content
    end

    if (index(upper(curline), 'CONTENT-ID:') > 0) then do
        id = substr(curline, index(upper(curline), 'CONTENT-ID:') + 13)
        if (index(id, ';') > 0) then id = substr(id, 1, index(id, ';'))
        id = compress(id, ' <>;'); foundcid = 1
    end
end

if (foundrel = 0) & (foundct = 0) then if (upper(value(tstem'.BINARY.DESC')) = 'TEXT/HTML' | upper(right(value(tstem'.BINARY'), 4)) = '.HTML' | upper(right(value(tstem'.BINARY'), 4)) = '.HTM') then foundct = 1

if (foundct) then do
    htmlstem = tstem
    if ~(saverel) then do
        return(1)
    end
end

if (foundcid) & (saverel) then do
    if (symbol(tstem'.PART.1.BINARY') = 'VAR') then do
        att = value(tstem'.PART.1.BINARY')
        if (exists(att)) then do
            cnt = atts.count; cnt = cnt + 1
            atts.cnt.cid  = id
            atts.cnt.file = att
            atts.count = cnt; drop cnt
        end
        return(1)
    end
end

if (symbol(tstem'.PART.COUNT') = 'VAR') & (value(tstem'.PART.COUNT') > 0) then do i = 1 to value(tstem'.PART.COUNT')
    newstem = tstem || '.PART.' || i || '.MSG'

    if (foundrel) then call findhtml(newstem, 1)
    else call findhtml(newstem, saverel)

    if (result = 1) then return(1)
end

return(0)



/**
*** SAVE A MESSAGEPART TO DISK
**/

savemsg: interpret 'procedure expose 'globals
            parse arg htmltext


/*
** Write text body
*/

if (symbol(htmltext'.TEXT.COUNT') = 'VAR') then do
    cnt = value(htmltext'.TEXT.COUNT')

    if (cnt > 0) then do
        fileopen = open(outfile, filename, 'W')
        if ~(fileopen) then do
            call fail('Couldn''t open "' || filename || '" for writing.')
            return(20)
        end

        select
            when (poster = 'mozilla') | (poster = 'outlook') then do
                do i = 1 to cnt
                    line = value(htmltext'.TEXT.'i)
                    if (index(line, 'cid:') > 0) then do
                        do j = 1 to atts.count
                            do while (index(line, 'cid:' || atts.j.cid) > 0)
                                line = substitute(line, 'cid:' || atts.j.cid, 'file://localhost/' || atts.j.file, 1)
                            end
                        end
                        call writeln(outfile, line)
                    end
                    else call writeln(outfile, line)
                end
            end
            otherwise do i = 1 to cnt
                call writeln(outfile, value(htmltext'.TEXT.'i))
            end
        end

        call close(outfile)
    end
    else if (symbol(htmltext'.PART.1.BINARY') = 'VAR') & (value(htmltext'.PART.1.BINARY.DESC') = 'text/html') then do
        htmlpath = value(htmltext'.PART.1.BINARY')
        if ~(exists(htmlpath)) then fail('text/html part was deleted or not found.')
        else address command 'Copy "'htmlpath'" TO "'filename'" QUIET'
    end

    else fail('text/html part was empty.')
end
else fail('Incorrect html message stem')

return(0)


/*
** Find an active browser, run one if none is found
*/

findbrowser: interpret 'procedure expose 'globals

/* Go through available ports */

ports = show('P')

do i = 1 to words(ports)
    if left(subword(ports, i), 5) = 'AWEB.'    then wwwport = subword(ports, i, 1)
    if left(subword(ports, i), 8) = 'AMOSAIC.' then wwwport = subword(ports, i, 1)
    if left(subword(ports, i), 7) = 'VOYAGER'  then wwwport = subword(ports, i, 1)
    if left(subword(ports, i), 7) = 'IBROWSE'  then wwwport = subword(ports, i, 1)
    if symbol('wwwport') = 'VAR' then break
end

if left(subword(ports, i), 5) = 'AWEB.' then do
    address(wwwport)
    'GET ACTIVEPORT'
    if (rc = 0 ) then wwwport = result
end

return(0)


/*
** Display an error message and exit
*/

fail: interpret 'procedure expose 'globals
      parse arg errtext

address(thorport)

'REQUESTNOTIFY TEXT "'errtext'" BUTTONTEXT "Abort"'
if (rc ~= 0) then do
    say 'Couldn''t open error requester: 'THOR.LASTERROR
    say 'Original error was: 'errtext
end

signal cleanup


/*
** Load preferences saved by CfgHTTP.thor
*/

loadprefs: interpret 'procedure expose 'globals

cfgfile = 'ENV:Thor/http.config'

if ~(exists(cfgfile)) then do
    address(thorport)
    'REQUESTNOTIFY TEXT "Could not find the configuration file.\nRun CfgHTTP to create one or quit." BT "CfgHTTP|Quit"'
    if (rc = 0) & (result = 1) then address command 'rx `GetEnv THOR/THORPath`rexx/cfghttp.thor'
    exit(0)
end
else do
    call open(prf, cfgfile, 'R')
    do until eof(prf)
        line = readln(prf)
        if upper(word(line, 1)) = 'BROWSEREXE' then wwwcmd = subword(line, 2)
    end
    call close(prf)
end

return(0)


 /****************************************************************************
********************* Substitute a string within a string *********************
******** Shamelessly ripped from Troels Walsted Hansen's UUDecode.thor ********
 ****************************************************************************/

substitute: interpret 'procedure expose 'globals
            parse arg str, org, new, quote

/*
** str   = original string
** org   = string to replace
** new   = string to replace with
** quote = add quotes around the string part replaced if there
**         aren't any quotes already (useful for URL replacing)
*/

lastfound = 0; if (quote = '') then quote = 0

found = index(str, org)

do while found > lastfound
    secondpart = substr(str, found + length(org))
    firstpart = substr(str, 1, length(str) - length(substr(str, found)))
    if (quote) then do
        if (right(firstpart, 1) ~= '"') then firstpart = firstpart || '"'
        if (left(secondpart, 1) ~= '"')   then secondpart = '"' || secondpart
    end
    str = firstpart || new || secondpart
    lastfound = found + length(new)
    found = index(str, org, lastfound)
end

return(str)